
Imports System
Imports System.IO
Imports System.Drawing

Partial Class tracker
    Inherits System.Web.UI.Page

    Private Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ' On Load, carry out action

        ' Check if running locally (for debugging)
        Dim bIsLocal As Boolean = HttpContext.Current.Request.Url.AbsoluteUri.StartsWith("http://localhost:")

        ' Set up database connection 
        Dim MyConn As OleDbConnection

        'Declare database connection variables
        Dim strConn As String = ConfigurationManager.ConnectionStrings("LocalConnectionString").ConnectionString
        MyConn = New OleDbConnection(strConn)

        ' Initialise
        Dim nErrNo As Integer = 0
        Dim sUser As String = "", sPassword As String = "", sCallback As String = ""
        Dim ptHere As PointF
        Dim nMaxRadius As Integer = 0

        ' Initialise the address object
        Dim AddressObject As AddressUKNET.Address = New AddressUKNET.Address()
        Try
            AddressObject = New AddressUKNET.Address()
        Catch
            nErrNo = 104
        End Try

        Dim sDataPath As String = "C:\inetpub\vhosts\2676620.cust.peer1.com\bifrost\webservices\App_Data"
        If bIsLocal Then sDataPath = "C:\Address"
        If Not AddressObject.InitAddress(sDataPath) Then
            nErrNo = 100
        Else
            ' Read username, password and function input parameters
            nErrNo = ReadParams(sUser, sPassword, ptHere, nMaxRadius, sCallback)
        End If

        If nErrNo > 0 Then
            XMLError(nErrNo)
            If Not AddressObject Is Nothing Then
                AddressObject.Close()
                AddressObject = Nothing
            End If
            Exit Sub
        End If

        'Connect to the Access database
        MyConn.Open()

        ' Check for valid user name & password
        nErrNo = IsUserValid(MyConn, sUser, sPassword)
        If nErrNo > 0 Then
            XMLError(nErrNo)
            If Not MyConn Is Nothing Then MyConn.Close()
            If Not AddressObject Is Nothing Then
                AddressObject.Close()
                AddressObject = Nothing
            End If
            Exit Sub
        End If

        ' Get details of the record that will be debited for this action
        Dim nID As Int32
        Dim bNotify As Boolean
        '      nErrNo = CreditRecord(MyConn, sUser, sPassword, func, nID, bNotify)

        ' Find the nearest postcode
        Dim sPostcode As String = ""
        Dim sAddress As String = ""
        Dim Closure As Double = 0.0
        If FindNearestPostcode(AddressObject, ptHere, 500, sPostcode, Closure) Then

            ' Get the address of that postcode
            LoadAddressLabel(AddressObject, sPostcode, sAddress)
        End If

        ' Output the result
        XMLResult(sPostcode, sAddress, Closure)

        'If the database is open, then close it
        If Not MyConn Is Nothing Then MyConn.Close()

        ' Destroy the Address object
        If Not AddressObject Is Nothing Then
            AddressObject.Close()
            AddressObject = Nothing
        End If


    End Sub

    Public Function ReadParams(ByRef sUser As String, ByRef sPassword As String, _
                                ByRef ptHere As PointF, ByRef nMaxRadius As Integer, _
                                ByRef sCallback As String) As Integer
        ' Parse input parameters
        ' Return: 0 - Success; 1 - Missing username; 2 - Missing password; 3 - Invalid user name/password; 4 - Missing/Invalid position, 
        ' 4 - Latitude precedes longitude; 6 - ; 7 - ; 8 - Only "S" allowed in demonstration 

        ' Initialise
        Dim nStatus As Integer = 0
        sUser = ""
        sPassword = ""
        nMaxRadius = 0
        ptHere = New PointF(0.0, 0.0)
        sCallback = ""

        ' Load user ID
        sUser = Request.QueryString("user")
        If sUser = "" Then
            nStatus = 1
        Else
            ' Load password
            sPassword = Request.QueryString("password")
            If sPassword = "" Then
                nStatus = 2
            End If
        End If

        If nStatus = 0 Then

            ' Load position
            Dim sPosition As String = Request.QueryString("position")
            If sPosition <> "" Then
                Dim Coords As String() = sPosition.Split(",")
                If Coords.Length = 2 Then
                    Try
                        ptHere.X = Convert.ToDouble(Coords(0))
                        ptHere.Y = Convert.ToDouble(Coords(1))
                    Catch
                        nStatus = 4
                    End Try
                Else
                    nStatus = 4
                End If

                ' Check over UK
                If Not PtInBritain(ptHere) Then
                    If PtInBritain(New PointF(ptHere.Y, ptHere.X)) Then
                        nStatus = 5
                    Else
                        nStatus = 4
                    End If
                End If
            Else
                nStatus = 4
            End If

            ' Load maximum radius of search
            Dim sMaxRadius As String = Request.QueryString("radius")
            If sMaxRadius <> "" Then
                Try
                    nMaxRadius = Convert.ToInt32(sMaxRadius)
                Catch
                    nStatus = 7
                End Try
                If nMaxRadius < 100 Then
                    nStatus = 7
                End If
            End If

            ' Load optional callback function name
            sCallback = Request.QueryString("callback")
        End If

        ' Return status code
        Return nStatus

    End Function

    Private Function PtInBritain(ByVal pt As PointF) As Boolean
        ' Check if a point is over the British Isles

        Dim bUK As Boolean = False
        If ((pt.X >= -12.0) And (pt.X <= 3.0) And (pt.Y >= 49.0) And (pt.Y <= 70.0)) Then
            bUK = True
        End If

        Return bUK

    End Function

    Public Function IsUserValid(ByRef MyConn As OleDbConnection, ByVal sUser As String, ByVal sPassword As String) As Integer
        ' Check if a user name/password is valid
        ' Return: 0 - OK; 4 - Not present; 101 - More than 1 present

        ' Initialise
        Dim nStatus As Integer = 0

        ' Count occurences of name/password in database
        Dim MySQL1 As String = "Select Count(*) FROM UserData WHERE UserName = '" & sUser & "' AND Password = '" & sPassword & "'"

        Dim cmdCount As New OleDbCommand(MySQL1, MyConn)
        Dim nPresent As Int32
        nPresent = Convert.ToInt32(cmdCount.ExecuteScalar())
        cmdCount.Dispose()

        ' Must be exactly one occurence
        If nPresent = 0 Then
            nStatus = 4
        ElseIf nPresent = 1 Then
            nStatus = 0
        Else
            nStatus = 101
        End If

        ' Return result
        Return nStatus

    End Function

    Public Function FindNearestPostcode(ByRef AddressObject As AddressUKNET.Address, ByVal ptHere As PointF, ByVal nMaxDist As Integer, _
                                    ByRef sPostcode As String, ByRef Closure As Double) As Boolean
        ' Find the postcode nearest to a position

        ' Initialise
        sPostcode = ""
        Closure = 0.0
        Dim bFound As Boolean = False

        ' Convert longitude/latitude to Easting/Northing
        Dim Easting As Double = 0.0, Northing As Double = 0.0
        AddressObject.GeoRefConvert(5, ptHere.X, ptHere.Y, 1, Easting, Northing)

        ' Load all postcodes in radius
        Dim iStat As Integer = 0, nCodes As Integer = 0
        Dim sCodes As String = ""
        iStat = AddressObject.GetCodesInRadius(Easting, Northing, nMaxDist, sCodes, nCodes)

        ' Find nearest postcode to centre
        Dim sCode As String = ""
        Dim MaxDistSq As Double = 99999.0, EastMin As Double = 0.0, NorthMin As Double = 0.0
        Dim iCode As Integer
        For iCode = 0 To nCodes - 1
            sCode = sCodes.Substring(iCode * 8, 8)
            Dim nEastCode As Integer = 0, nNorthCode As Integer = 0
            Dim sError As String = ""
            sError = ""
            If AddressObject.GetGridReference(sCode, nEastCode, nNorthCode, sError) Then
                Dim xDiff As Double = Easting - nEastCode
                Dim yDiff As Double = Northing - nNorthCode
                If (xDiff * xDiff + yDiff * yDiff) < MaxDistSq Then
                    sPostcode = sCode
                    EastMin = nEastCode
                    NorthMin = nNorthCode
                    bFound = True
                    MaxDistSq = (xDiff * xDiff + yDiff * yDiff)
                End If
            End If
        Next

        ' Find error of closure
        If bFound Then
            Dim lngMin As Double = 0.0, latMin As Double = 0.0
            AddressObject.GeoRefConvert(1, EastMin, NorthMin, 5, lngMin, latMin)
            Closure = EarthDist(ptHere.X, ptHere.Y, lngMin, latMin)
        End If

        ' Return True if a postcode in range
        Return bFound

    End Function

    Public Function LoadAddressLabel(ByRef AddressObject As AddressUKNET.Address, ByVal sPostcode As String, _
                                    ByRef sAddress As String) As Integer
        ' Load the road-level address for a postcode (If a large organisation, premise data is included)
        ' Return 0 - OK; 1 - Unknown/invalid postcode; 2 - Area data system error; 3 - road data system error

        ' Initialise
        Dim nErr As Integer = 0
        sAddress = ""
        Dim sAreaData As String = "", sRoadData As String = ""

        ' Position cursor
        If AddressObject.SeekPostcode(sPostcode) <> 0 Then
            nErr = 103
            Exit Function
        End If

        ' Load town/county data
        If AddressObject.GetAreaData(sAreaData) <> 0 Then
            nErr = 103
            Exit Function
        End If
        Dim fldsArea As String() = sAreaData.Split(",")

        ' Load thoroughfare data
        If AddressObject.GetRoadData(sRoadData) <> 0 Then
            nErr = 2
            Exit Function
        End If
        Dim fldsRoad As String() = sRoadData.Split(",")

        ' Build the address label
        sAddress = MakeLabel(fldsArea, fldsRoad)

        ' Return status
        Return nErr

    End Function

    Public Function MakeLabel(ByVal fldsArea As String(), ByVal fldsRoad As String()) As String
        ' Construct a label suitable for an envelope

        ' Initialise
        Dim sLabel As String = ""

        ' Find if county is omitted by convention
        Dim sCounty As String = fldsArea(1)
        If sCounty.Substring(0, 1) = "(" Then sCounty = ""

        ' Combine address elements to road level
        If (fldsRoad(3) <> "") Then sLabel = sLabel + fldsRoad(3) + ";"
        If (fldsRoad(4) <> "") Then sLabel = sLabel + fldsRoad(4) + ";"
        If (fldsRoad(5) <> "") Then sLabel = sLabel + fldsRoad(5) + ";"
        If (fldsRoad(6) <> "") Then sLabel = sLabel + fldsRoad(6) + ";"
        sLabel = sLabel + fldsArea(0).ToUpper() + ";"
        If (sCounty <> "") Then sLabel = sLabel + sCounty + ";"
        sLabel = sLabel + fldsRoad(0)

        ' If a Large organisation, premise information is present in road-level field
        Dim sPrem As String = ""
        If ((fldsRoad(1) <> "") Or (fldsRoad(2) <> "")) Then
            sPrem = fldsRoad(1)
            If ((sPrem <> "") And (fldsRoad(2) <> "")) Then sPrem += ";"
            sPrem += fldsRoad(2)
            PrefixPremise(sPrem, sLabel)
        End If

        ' Return result
        Return sLabel

    End Function

    Public Sub PrefixPremise(ByVal sPremise As String, ByRef sAddress As String)
        ' Prefix an address string with premise elements

        ' Validate
        Dim cbPremise As Integer = sPremise.Length
        If cbPremise < 1 Then Exit Sub
        Dim bNewLine As Boolean

        ' Check if last character is a number
        If Char.IsDigit(sPremise.Substring(cbPremise - 1, 1)) Then

            ' If a PO box add a newline
            If (sPremise.IndexOf("PO Box") >= 0) Then
                bNewLine = True

                ' Otherwise assume premise number and use a separating space
            Else
                bNewLine = False
            End If

            ' If penultimate character is a number, assume premise number
            ' such as '21B' and use a space
        ElseIf ((cbPremise > 1) And Char.IsDigit(sPremise.Substring(cbPremise - 2))) Then
            bNewLine = False

            ' Otherwise, introduce a newline
        Else
            bNewLine = True
        End If

        ' Join premise and road address with newline or space
        If bNewLine Then
            sAddress = sPremise + ";" + sAddress
        Else
            sAddress = sPremise + " " + sAddress
        End If

    End Sub

    Public Function EarthDist(ByVal long1 As Double, ByVal lat1 As Double, ByVal long2 As Double, ByVal lat2 As Double) As Double
        ' Finds the distance between points on earth ellipsoid in metres.
        ' Taken from Astronomical Algorithms, Jean Meeus, second edition.

        ' Convert degrees to radians
        Dim RAD As Double = (Math.PI / 180.0)
        Dim f As Double = (lat1 + lat2) / 2 * RAD
        Dim g As Double = (lat1 - lat2) / 2 * RAD
        Dim l As Double = (long1 - long2) / 2 * RAD

        Dim sg As Double = Math.Sin(g)
        Dim sl As Double = Math.Sin(l)
        Dim sf As Double = Math.Sin(f)
        Dim s As Double, c As Double, w As Double, r As Double, d As Double, h1 As Double, h2 As Double

        Dim a As Double = 6377563.396      ' major semi-axis of ellipsoid
        Dim b As Double = 6356256.91       ' minor semi-axis of ellipsoid
        Dim flattn As Double = a / (a - b)
        Dim fl As Double = 1.0 / flattn

        sg = sg * sg
        sl = sl * sl
        sf = sf * sf
        s = sg * (1 - sl) + (1 - sf) * sl
        c = (1 - sg) * (1 - sl) + sf * sl

        If (s = 0.0) Or (c = 0.0) Then Return -1 ' Error

        w = Math.Atan(Math.Sqrt(s / c))
        r = Math.Sqrt(s * c) / w
        d = 2 * w * a
        h1 = (3 * r - 1) / 2 / c
        h2 = (3 * r + 1) / 2 / s

        Return d * (1 + fl * (h1 * sf * (1 - sg) - h2 * (1 - sf) * sg))

    End Function

    Public Sub XMLResult(ByVal sPostcode As String, ByVal sAddress As String, ByVal Closure As Double)
        ' Output an XML file of the results

        ' Initialise


        ' Create an XmlTextWriter instance
        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        ' Write XML header
        With XmlWriter

            .WriteStartDocument()

            .WriteStartElement("Result")

            ' Output position data
            If sPostcode <> "" Then
                .WriteElementString("PCD", sPostcode)
                .WriteElementString("LABEL", sAddress)
                Dim nClosure As Integer = Closure + 0.5
                .WriteElementString("DIST", nClosure.ToString())
            End If

            ' Finish writing
            .WriteEndDocument()
            .Close()

        End With

    End Sub

    Public Sub JSONResult(ByVal sPostcode As String, ByVal sAddress As String)
        ' Output an JSON file of the results

        ' Initialise


        ' Create a TextWriter instance
        Response.ContentType = "application/json"
        Dim twsJSON As TextWriter = New StreamWriter(Response.OutputStream)

        ' Write opening lines
        With twsJSON
            .Write("{" + vbCrLf)
            .Write(" ""Result"":" + vbCrLf)
            .Write(" [" + vbCrLf)

            .Write(" ""PCD"": """ + sPostcode + """" + vbCrLf)

            ' Output a label
            .Write(" ""Label"": """ + sAddress + """," + vbCrLf)

            ' Finish writing
            .Write(" ]" + vbCrLf)
            .Write("}" + vbCrLf)
            .Close()
        End With

    End Sub

    Public Sub XMLError(ByVal nErr As Integer)
        ' Output an XML file notifying an error
        ' Doesn't seem to work try: Response.Write("<html>" + nErr + "</html>")


        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        ' Write XML header
        With XmlWriter

            .WriteStartDocument()
            .WriteStartElement("Result")

            ' Output error code and matching message
            Select Case nErr
                Case 1
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Missing user name")

                Case 2
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Missing password")

                Case 3
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Invalid user name or password")

                Case 4
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Missing or invalid position")

                Case 5
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Longitude must precede latitude")

                Case 9
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Only codes starting with CB1-CB3 are allowed while testing")

                Case 10
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "Postcode outside licensed Areas")

                Case 100
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "System error: could not initialise addressing system")

                Case 101
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "System error: duplicate user")

                Case 102
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "System error: invalid credit check")

                Case 103
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "System error: error in addressing system")

                Case 104
                    .WriteElementString("ErrCode", nErr.ToString())
                    .WriteElementString("ErrMessage", "System error: could not create addressing object")
            End Select

            ' Finish writing
            .WriteEndElement()
            .WriteEndDocument()
            .Close()

        End With

    End Sub


End Class
